home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / music / 7 / modula / srpnsk.mod < prev   
Text File  |  1985-11-19  |  3KB  |  136 lines
  1. IMPLEMENTATION MODULE Sierpinski;
  2.  
  3. (* TDI GEM Demo : Draw Sierpinski curve *)
  4. (* (c) TDI Software Ltd. 1985. *)
  5.  
  6. (*$S-*)(*$T-*)
  7.  
  8. FROM GEMVDIbase IMPORT
  9.      (* types *) VDIWorkInType, VDIWorkOutType ;
  10.  
  11. FROM VDIControls IMPORT
  12.      (* procs *) OpenVirtualWorkstation, CloseVirtualWorkstation ;
  13.  
  14. FROM VDIOutputs IMPORT
  15.      (* procs *) PolyLine ;
  16.  
  17. FROM AESGraphics IMPORT
  18.      (* procs *) GrafHandle;
  19.  
  20. FROM GemDem IMPORT
  21.      (* vars  *) WorkX, WorkY, WorkWidth, WorkHeight ;
  22.  
  23. VAR currentX, currentY : INTEGER;
  24.  
  25. CONST SquareSize = 256;
  26.  
  27. VAR
  28.   Px, Py,
  29.   i, h,
  30.   x0, y0 : CARDINAL;
  31.   ch     : CHAR;
  32.   Points : ARRAY [0..3] OF INTEGER;
  33.   handle : INTEGER;
  34.   In     : VDIWorkInType;
  35.   Out    : VDIWorkOutType;
  36.   dummy  : INTEGER;
  37.  
  38. PROCEDURE Line ( direction, length : CARDINAL ) ;
  39.   PROCEDURE LineR(x, y : CARDINAL ) ;
  40.   VAR aX, aY : INTEGER;
  41.   BEGIN
  42.     aX := INTEGER(x);
  43.     aY := INTEGER(y);
  44.     Points [0] := currentX;
  45.     Points [1] := currentY;
  46.     currentX := currentX + aX;
  47.     currentY := currentY + aY;
  48.     Points [2] := currentX;
  49.     Points [3] := currentY;
  50.     PolyLine (handle, 2, Points);
  51.   END LineR;
  52.  
  53. BEGIN
  54.   CASE direction OF 
  55.     0 : LineR(length,0 ) ;           |
  56.     1 : LineR(length,length) ;       |
  57.     2 : LineR(0,length) ;            |
  58.     3 : LineR(-INTEGER(length),length) ;      |
  59.     4 : LineR(-INTEGER(length),0) ;           |
  60.     5 : LineR(-INTEGER(length),-INTEGER(length)) ;     |
  61.     6 : LineR(0,-INTEGER(length)) ;           |
  62.     7 : LineR(length,-INTEGER(length)) ;      |
  63.   END ;
  64. END Line ;
  65.  
  66.  
  67. PROCEDURE A ( k : CARDINAL );
  68.  
  69. BEGIN
  70.   IF k > 0 THEN
  71.     A(k-1); Line(7,h); B(k-1); Line(0,h);
  72.     D(k-1); Line(1,h); A(k-1);
  73.   END;
  74. END A;
  75.  
  76.  
  77. PROCEDURE B ( k : CARDINAL );
  78.  
  79. BEGIN
  80.   IF k > 0 THEN
  81.     B(k-1); Line(5,h); C(k-1); Line(6,h);
  82.     A(k-1); Line(7,h); B(k-1);
  83.   END;
  84. END B;
  85.  
  86.  
  87. PROCEDURE C ( k : CARDINAL );
  88.  
  89. BEGIN
  90.   IF k > 0 THEN
  91.     C(k-1); Line(3,h); D(k-1); Line(4,h);
  92.     B(k-1); Line(5,h); C(k-1);
  93.   END;
  94. END C;
  95.  
  96.  
  97. PROCEDURE D ( k : CARDINAL );
  98.  
  99. BEGIN
  100.   IF k > 0 THEN
  101.     D(k-1); Line(1,h); A(k-1); Line(2,h);
  102.     C(k-1); Line(3,h); D(k-1);
  103.   END;
  104. END D;
  105.  
  106.  
  107. CONST Depth = 6;  (* because it looks nice *)
  108.  
  109. PROCEDURE DoSierpinski;
  110.  
  111. BEGIN
  112.   FOR dummy := 0 TO 8 DO In [dummy] := 1 END;
  113.   In [10] := 2;
  114.   handle := GrafHandle (dummy, dummy, dummy, dummy);
  115.   OpenVirtualWorkstation (In, handle, Out);
  116.   i := 0;
  117.   h := SquareSize DIV 8; (* to accomodate resolution *)
  118.   x0 := CARDINAL(WorkWidth-WorkX-1) DIV 2 + CARDINAL(WorkX);
  119.   y0 := CARDINAL(WorkHeight-WorkY-1) DIV 2 + h + CARDINAL(WorkY);
  120.   REPEAT
  121.     INC (i);
  122.     DEC (x0,h);
  123.     h := h DIV 2;
  124.     INC (y0,h);
  125.     currentX := x0;
  126.     currentY := y0;
  127.     A (i); Line (7,h);
  128.     B (i); Line (5,h);
  129.     C (i); Line (3,h);
  130.     D (i); Line (1,h);
  131.   UNTIL (i = Depth);
  132.   CloseVirtualWorkstation (handle);
  133. END DoSierpinski;
  134.  
  135. END Sierpinski.
  136. əəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəə